perm filename CCRMA.CHG[NEW,LCS]7 blob sn#564867 filedate 1981-02-17 generic text, type T, neo UTF8
*********** CHANGES SINCE MOVE TO CCRMA **********

NEWMRK.F4****************

	[SUBROUTINE DASHES(IX,R2,RD)]

2	SZ=RN(J+5)
	R5=SZ*RSTJ2
C R=REAL SIZE FACTOR FOR SPACE     RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
	RP=R5*RN(J+9)+A
→→→	IF(RP.LT.0)RP=3.0
C RP=RIGHT SIDE OF LEFT CHAR. STRING.
	R3=RP
→→→	IF(B.GT.201)B=201.
	R6=B-R5*BSIZE
CC	RR6=R6
→→→	IF(R3.LT.0)R3=4.


10	R6=R6-RDZ
CC10	R6=R3+(RR3+A)*B-RR3-RDZ
	RD(6)=RR3
	RD(7)=A/RSTJ2
C P9(SPACE BETWEEN DASHES) REAL SIZE IS P9*RSTJ2
CCC	GO TO 4
CCC11	RD(5)=0
4	RD(2)=RN(J+4)+1.0-R5*0.5


	SUBROUTINE CMDIN
C SAVES INPUT LINES WHEN 1ST CHAR. IS :
C OUTPUTS SAVED LINES WHEN 1ST CHAR. IS ;
	COMMON /ALF/INP(72)
	DIMENSION J(60)
	EQUIVALENCE (I1,INP),(I2,INP(2)),(I3,INP(3))
	DATA J/60*' '/
	IF(I1.EQ.';')GO TO 11
C JUMP TO GET BACK COMMAND 1, 2 OR 3 (; ;; ;;;)
   	N=2
	L=1
	LL=1
10	NN=N+19
	DO 2 K=N,NN
	M=INP(K)
	IF(M.EQ.':')GO TO 3
	J(L)=M
2	L=L+1
	IF(K.EQ.NN)GO TO 6
3	DO 5 KK=K,NN
	J(L)=' '
5	L=L+1
4	IF(M.NE.':')GO TO 6
C 3 COMMANDS CAN BE GIVEN ON ONE LINE, EACH STARTS WITH :
C  THE 1ST ONE WILL BE ACTIVATED IMMEDIATELY, OR BY TYPING ;
C THE 2ND AND 3RD ARE ACTIVATED BY TYPING ;; OR ;;;
C NO ERROR TRAP FOR MORE THEN 3 COLONS
	LL=LL+20
	L=LL
	N=K+1
	GO TO 10
6	N=1
9	NN=N+19
	L=0
	DO 7 K=N,NN
	L=L+1
7	INP(L)=J(K)
	DO 8 K=21,72
C CLEAR REST OF INP ARRAY
8	INP(K)=' '
	RETURN
11	N=1
	IF(I2.EQ.';')N=21
	IF(I3.EQ.';')N=41
	GO TO 9
C  GO GET BACK COMMAND 1, 2 OR 3  (; ;; ;;;)
	END



MS.F4****************

290	SCORE=-1
CQQ     ACCEPT 89,INP
	READ(IDEV,700,END=240)INP
	IF(I1.EQ.LESS)GO TO 240
C  '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
	IF(I1.NE.IGT)GO TO 300
C  '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
	IF(X22.NE.0)GO TO 260
	GO TO 230
300	IF(I1.EQ.':')CALL CMDIN 
	IF(I1.EQ.ISEMI)CALL CMDIN 
C TYPE : AS FIRST ITEM TO SAVE COMMAND LINE.  TYPE ; TO REPEAT IT.
   	CALL LULOOP
	IF(IDEV.EQ.5)GO TO 320
	IF(I7.NE.LTT)GO TO 320
	IF(I1.NE.LCC)GO TO 320
C 'ET' DIRECTORY? UGH!!!
310	READ(IDEV,700)INP

→→→	5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/,FILNAM/'INIT'/
	DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/

710	IF(I2.NE.IXX)GO TO 715 
C TYPE 'NX' TO RESTART WITH NEXT ALPHABETICAL FILE NAME (ONLY 5TH LETTER THOUGH.)
	I1=LRR
	I2=LSS
	I4=PLUS
	GO TO 10
715	IF(QUICK.NE.0)GO TO 720


	IF(I2.NE.LDD)GO TO 1065
C FOR 'CD' CENTER DASHES
	JJ2=1
	GO TO 1785
1065	KNT=0
	SCORE=0
1070	KNT=KNT+1

1230	R4=RZMY+R3
	R3=RZMX
	I1=0
C I1=0 STOPS REDRAWING OF SPACING SCALE FOR UP-DOWN ZOOMS
	GO TO 1210

1310	R4=0
	R2=0
	IF(RZMSZ.LE.1)GO TO 1315
C PUT UP SPACING SCALE ABOVE STAFF 1 FOR ZOOMS .GT.1
C 2/81    	IF(RZMSZ.LT.2)R2=1.
C NO***** SETS HEIGHT OF SPACE NUMS. DEPENDING ON ZOOM FACTOR
	R2=1
	IF(I1.NE.0)CALL SCL
	R2=0
1315	R3=0
	R4=0
	LCEN=0
	MCEN=0
C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
	JFONT=0
1320	M=1


1770	IF(I2.EQ.IBLA)GO TO 1780
	IF(I2.EQ.LDD)GO TO 1060
C NOW 'CD', WHEN NOT IN EDIT MODE = CENTER ALL DASHES ON A LINE. (USES GRED)
1780	CALL MOVER
	IF(R2.GE.99)GO TO 260
C   99(+)=BACKUP OUT OF MOVER ETC.
	JFONT=0
1785	IGO=0
C  SO IT WON'T DO ALL FONT LOOKUPS.
1790	IF(JJ2)GO TO 130


2240	IF(K.NE.PLUS)GO TO 2245
C NOW NEXT-TO-LAST LETTER IS MOVED UP, LAST LETTER IS RESET TO 'A'
	NAME=((NAMZ+256).AND."777777777400).OR."202
C   .AND.ETC ZEROS LAST 8 BITS, .OR."202 PUTS IN 'A'
	NAMZ=NAME
	K=0
	GO TO 2265
2245	CALL TYPSTR(' NAME.EXT?  ')
	READ(IDEV,700,END=240)INP
C GO PUT A1'S INTO A5, ETC.
	CALL NAMEXT(INP,NAME,EXT)
	IF(NAME.EQ.IBLA)GO TO 2270
	IF(NAME.NE.'99')GO TO 2250
C TYPE '99' TO BACK OUT OF 'SAVE'.
	NAME=L
	EXT=X
	GO TO 130
2250	IF(I1.NE.LESS)GO TO 2260
	IDEV=5
	GO TO 2240
2260	CALL LO2UP(NAME)
	CALL LO2UP(EXT)
	K=NAME
	IF(NAME.EQ.PLUS)NAME=NAMZ+2
C NAME='+' WHEN "NX" HAS BEEN TYPED. (UPS LAST LETTER OF FIVE TO NEXT)
2265	IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240
C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
2270	JA=-1


2260	CALL LO2UP(NAME)
	CALL LO2UP(EXT)
	IF(NAME.EQ.PLUS)NAME=NAMZ+2

2290	K=NAME
	NAMZ=K
C  SAVE THE NAME FOR '+' ROUTINE (GOES UP THE ALPHABET)
	IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240

→→→	NAMZ=L
2310	RSTF=0



SLOOP.FAI****************

SLOOP:	0
→→→	SETZM CIX	;INITIALIZE HALF-SLUR FLAG


LOOP.FAI****************

BOX:	0    	;CALL BOX(I,R)   SEE PLTSRT.F4 FOR FORTR. VERSION
	MOVE IDEV
	CAIE 5
	JRST BX4-3	;UPDATE IOLD    JRA 16,2(16)	;IF(IDEV.NE.5)RETURN


WORDS.F4****************

	1 J4,L,Y,K,RX,RZ,RA,J5  /XRN/RN(1) /ALF/INP(1) /IDEV/IDEV
C12/80	1 J4,L,Y,K,RX,RZ,RA,J5  /XRN/RN(1) /ALF/INP(72),ML

431	FORMAT(100A1)
	IF(IDEV.NE.5)GO TO 131
231	IDEV=5
	CALL TYPSTR('TYPE UP TO 100 CHARS--')
	CALL TYPCRL
131	READ(IDEV,431,END=231)(INP(KN),KN=1,100)
C12/80 131	CALL TYPE
C12/80 531	DO 31 KN=72,1,-1
C NOW 100 CHARACTERS ACCPTED IN 'TYPE' MODE
531	DO 31 KN=100,1,-1

317	ML=L
	DO 417 N=IA,KN
C12/80	IF(ML.LT.72)ML=ML+1
	IF(ML.LT.100)ML=ML+1

	IF(J2.GT.7)RETURN
C CATCH STAFF TYPO ERROR
	KNT=-1

317	ML=L
	DO 417 N=IA,KN
→→→	IF(ML.LT.72)ML=ML+1
C MAKE ABOVE MORE 'ELEGANT'


SLRSCL.F4****************

SUBROUTINE SETLET

	IF(IDEV.EQ.1)GO TO 44
	CALL DPYSET(3,SU,320)  [DELETE THESE ABOVE!!]
	CALL DPYBRT(6)
	DO 4 K=2,M
	R3=RHORZ(RPOS(1,K))
	CALL PNUM
	J5=J5+1
4	IF(J5.EQ.10)J5=0
	CALL DPYOUT(3)
	CALL SETPOG(1)
44	RPOS(1,M+1)=200

2267	IF(V(3).EQ.0.AND.IDEV.NE.1)GO TO 267
C WHEN TYPING, NOTE NUMS CAN BE ON 1 LINE IF THERE ARE >2.  (VERT. POS. MUST BE PRESET)


BEAMS.F4*****************

	SUBROUTINE BMREAD
	COMMON  /ALF/INP(72) /IDEV/IDEV
	CALL TYPE
C12/80	IF(IDEV.EQ.5)WRITE(21,4501)INP
	IF(IDEV.EQ.5)CALL INPOUT
C  WRITES OUT INPUT LINE.

SCMSS.F4********************

11	RB=0
	IF(MODE.LE.2)GO TO 111
	IF(IDEV.NE.5)GO TO 111
C SKIP IF READING AN EDIT FILE

3377	CALL OFILE(21,NAMSC)
C12/80	WRITE(21,2114)INP
	CALL INPOUT
C WRITE OUT 'IN' ETC.

	IF(IDEV.EQ.5)CALL INPOUT
C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
C WRITE OUT SPACING INFO
5333	CALL A2READ(K,RA)

80041	IF(IDEV.EQ.5)CALL INPOUT
C12/80  80041	IF(IDEV.EQ.5)WRITE(21,2114)INP

	IF(IDEV.EQ.5)CALL INPOUT
C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
	CALL LULOOP
77732	CALL LNEND


RHYTH.F4 *********************

	(SUBROUTINE NOTNUM)
	CALL DPYSET(3,ST(3200),390)
C LOCATION 3200 IN ST COULD BE IN USE IF MUCH DATA ON SCREEN. (DOESN'T MATTER)


GREDX.F4*************

SUBROUTINE GRED

	COMMON /MKX/KSLA,ISEMI,LESS,IGT
	1/A2Z/LAA,LBB,LCC,LDD,NONO(7),LEL,LMM,LNN,NON(9),LXX

4	JA=98
C  DEL=FOR DELETIONS   CD=CENTER DASHES BETWEEN SYLLABLES.
	IF(I2.EQ.LDD)JA=0

	IF(I2.NE.LDD)GO TO 71
C NEXT FOR 'CD'  CENTER DASHES WITH TEXT
	IF(RB.NE.4.)GO TO 6
	IF(RN(JY).LT.8.)GO TO 6
C P10 MUST BE .GT.0
	CALL DASHES(ITEM,RN(JY+2),RN(JY+3))
	GO TO 6

71	IF(V(1).EQ.12)GO TO 77
	IF(V(1).EQ.100)GO TO 341
C USE P100 AND ANY CODE# TO CREATE CUES. I.E. MINI NOTES, RESTS, BEAMS.
	IF(RC.EQ.999)GO TO 143
C  USE P12 TO INVERT STEM, BEAM AND SLURS ALL AT ONCE.
C  SET 12 TO 1 WITH CODE 5 TO INVERT SLURS ONLY
77	RC=0
	IF(RB.EQ.5)GO TO 141
	IF(RB.NE.6)GO TO 143
	IF(RX.EQ.1)GO TO 141
143	IF(RX.NE.44.)GO TO 144
C USE CODE 44 FOR ALL 'LINE' EXCEPT BARLINES.
	IF(RB.NE.4)GO TO 6
	IF(RN(JY).LE.2)GO TO 6
	GO TO 100
144	IF(RB.NE.RX.AND.RX.NE.0)GO TO 6
CXX	IF(ASK)GO TO 100
CXX	CALL ASKIT
CXX	IF(K.EQ.LNN)GO TO 6
CXX	IF(K.EQ.LXX)GO TO 19
100	IF(INP(1).EQ.LAA)GO TO 141


****** JUSTFY.F4

	IF(RN(L+8).NE.0)GO TO 250
C P8=-1 MEANS WHOLE MEASURE REST (NEVER DOT, P6 CAN HAVE NUMB.)
C P8=POS MEANS WHOLE MEASURE REST WITH NUMBER.
44	IF(RL.GE.4)RB=RN(L+6)*1.5

******* JUST.F4

1	FORMAT(' INPUT NAME.EXT 1?  '$)
3011	FORMAT(' TYPE OUTPUT NAME.EXT 1 -- '$)
	TYPE 60,NM,OUTX
60	FORMAT(1XA5,'.',A3)


CODE4.FAI**********

	SKIPG .COMM.+=10   ;	26420	      IF(R9.LE.0)RZ=RJ
      	MOVEM 	02,ALF+=18    
;26430	  P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)

PAGE*******
TRNSP.F4*********
 SUBR. RVRS

CCC	IF(Q(J+5).LT.10)GO TO 10
	IF(Q(J+5).LT.10)GO TO 202
C  JUMP IF NO STEM ON IT
	IF(Q(J+8).GT.999.)GO TO 202
	B=Q(J)
	IF(B.GT.7.AND.Q(J+10).NE.0)GO TO 202
C  JUMP IF GRACE NOTE (P8=1000 OR P10=-1) OR ON ANOTHER STAFF.
	IF(B.GT.6.AND.Q(J+9).LT.0)GO TO 202
C SKIP NOTES WITH NO LEDGER LINES
	KK=K+1
3	IF(KK.GT.LEND)GO TO 102

********* PLOT3.FAI *********

PL1:	MOVE 4,LX
	. . . .
	MOVE 7,4		;AC5 HAS REMAINDER
	SKIPE 5		;DON'T SUBTRACT IF AC5 IS ALREADY 0
	SOJ 5,			;LESS 1 BECAUSE . . . . .